home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Decision Cube / mxbutton.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  22KB  |  728 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Borland Delphi Visual Component Library         }
  4. {                                                       }
  5. {       Copyright (c) 1997,99 Inprise Corporation       }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit mxbutton;
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, Messages, SysUtils, Classes, Graphics, Grids, Buttons, Controls,
  15.   StdCtrls, Forms, Dialogs, Bde, DB, DBTables, Menus, ExtCtrls,
  16.   mxConsts, mxdb, mxstore, mxcommon;
  17.  
  18. type
  19.   TMenuProp = (tmChecked, tmRadio, tmNone);
  20.  
  21.   TQuickMenuItem = class(TMenuItem)
  22.   private
  23.     Action: Integer;
  24.   end;
  25.  
  26.   TQuickMenu = class(TPopUpMenu)
  27.   private
  28.     FOnSelected: TNotifyEvent;
  29.     procedure EHOnItemClick(Sender: TObject);
  30.   public
  31.     FAction: Integer;
  32.     iDim: Integer;
  33.     dimGroup: TDimGroup;
  34.     isGroupStart: Boolean;
  35.     Index: Integer;
  36.     Cell: Integer;
  37.     ValueIndex: Integer;
  38.     procedure Clear;
  39.     procedure SetTitle(value: String);
  40.     procedure AddLine(const value: String; Prop: TMenuProp; Action: Integer);
  41.     procedure PopUpAtMe(aControl: TWinControl; x,y: Integer);
  42.     property OnSelected: TNotifyEvent read FOnSelected write FonSelected;
  43.   end;
  44.  
  45.   TPivotButtonMouseState = (xmNone, xmPushed, xmDragging);
  46.   TPivotButtonType = (pbDimension, pbTarget, pbSummary, pbInactive);
  47.  
  48.   TPivotButton = class(TSpeedButton)
  49.   private
  50.     FType: TPivotButtonType;
  51.     FSource: TDecisionSource;
  52.     FMenu: TQuickMenu;
  53.     FMouseState: TPivotButtonMouseState;
  54.     SaveX: Integer;
  55.     SaveY: Integer;
  56.     myDim: Integer;
  57.     myDimInfo: TDimInfo;
  58.     procedure SetState(Value: TPivotButtonMouseState);
  59.     procedure SetMyDim(iDim: Integer);
  60.     procedure SetDecisionSource(Value: TDecisionSource);
  61.     procedure SelectButtonValue;
  62.     procedure SelectButtonProperties;
  63.     procedure EHOnValue(Sender: TObject);
  64.     procedure EHOnProperty(Sender: TObject);
  65.   protected
  66.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  67.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  68.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  69.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  70.     procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
  71.     procedure DragCanceled; override;
  72.     procedure Paint; override;
  73.   public
  74.     constructor Create(AOwner: TComponent); override;
  75.     destructor Destroy; override;
  76.     procedure Click; override;
  77.     procedure DragDrop(Source: TObject; X, Y: Integer); override;
  78.     property DimInfo:TDimInfo read myDimInfo;
  79.     procedure NewState;
  80.     procedure SetType(Value: TPivotButtonType);
  81.   published
  82.     property Parent;
  83.     property DecisionSource: TDecisionSource read FSource write SetDecisionSource;
  84.     property iDim: Integer read myDim write SetMyDim;
  85.   end;
  86.  
  87.   TDecisionButtonPosition = (xtHorizontal, xtVertical, xtLeftTop);
  88.   TDecisionButtonGrouping = (xtCheck, xtRadio, xtSequential);
  89.  
  90.   TDecisionPivotOption = (xtRows, xtColumns, xtSummaries);
  91.   TDecisionPivotOptions = set of TDecisionPivotOption;
  92.  
  93. implementation
  94.  
  95. const
  96.   crDimMove = 100;
  97.   crDimIns = 101;
  98.   bmpRows = 102;
  99.   bmpCols = 103;
  100.  
  101.   { TPivotButton methods }
  102.  
  103. constructor TPivotButton.Create(AOwner: TComponent);
  104. begin
  105.   inherited Create(AOwner);
  106.   SetState(xmNone);
  107.   AllowAllUp := True;
  108.   Enabled := True;
  109.   Caption := '';
  110.   GroupIndex := 0;
  111.   Screen.Cursors[crDimMove] := LoadCursor(HInstance, 'DIMMOVE');
  112.   Screen.Cursors[crDimIns] := LoadCursor(HInstance, 'DIMINS');
  113. end;
  114.  
  115. destructor TPivotButton.Destroy;
  116. begin
  117.   FMenu.free;
  118.   FMenu := nil;
  119.   inherited Destroy;
  120. end;
  121.  
  122. procedure TPivotButton.SetDecisionSource(Value: TDecisionSource);
  123. begin
  124.   if (Value <> FSource) then FSource := Value;
  125. end;
  126.  
  127. procedure TPivotButton.SetMyDim(iDim: Integer);
  128. begin
  129.   myDim := iDim;
  130.   NewState;
  131. end;
  132.  
  133. procedure TPivotButton.SetType(Value: TPivotButtonType);
  134. begin
  135.   FType := Value;
  136. end;
  137.  
  138. procedure TPivotButton.NewState;
  139. begin
  140.   if (myDim >= 0) and assigned(FSource) and (myDim <= FSource.nDims) then
  141.   begin
  142.     myDimInfo.iGroup := FSource.GetGroup(myDim);
  143.     myDimInfo.iValue := FSource.GetValue(myDim);
  144.     myDimInfo.iState := FSource.GetState(myDim);
  145.     myDimInfo.iRowState := FSource.GetRowState(myDim);
  146.     myDimInfo.iIndex := FSource.GetIndex(myDim, False);
  147.     myDimInfo.iActiveIndex := FSource.GetIndex(myDim, True);
  148.     FType := pbDimension;
  149.   end
  150.   else
  151.   begin
  152.     Caption := '';
  153.     myDimInfo.IIndex := -1;
  154.     myDimInfo.IActiveIndex := -1;
  155.   end;
  156.   flat := (myDimInfo.IState in [dmDrilled, dmPaged]) or (FType in [pbSummary, pbTarget, pbInactive]);
  157.  
  158.   if (MyDimInfo.IState = dmOpen) then
  159.     Down := True
  160.   else
  161.     Down := False;
  162.   SetState(xmNone);
  163.   Invalidate;
  164. end;
  165.  
  166. procedure TPivotButton.CMDesignHitTest(var Msg: TCMDesignHitTest);
  167. begin
  168.   if (Msg.Pos.X>Width shr 2) and (msg.Pos.x<width-width shr 2) and
  169.   (msg.Pos.Y>Height shr 2) and (msg.Pos.Y<Height-height shr 2) then
  170.     Msg.Result := 1
  171.   else
  172.     msg.Result := 0;
  173. end;
  174.  
  175. procedure TPivotButton.Click;
  176. begin
  177.   case FType of
  178.     pbSummary,
  179.     pbInactive:    SelectButtonValue;
  180.     pbDimension:
  181.       if (myDimInfo.IState in [dmDrilled, dmPaged]) then
  182.         SelectButtonValue
  183.       else if (FMouseState <> xmDragging) then
  184.         DecisionSource.ToggleDimIndex(myDimInfo.iGroup, myDimInfo.IIndex, False);
  185.   end;
  186. end;
  187.  
  188. procedure TPivotButton.Mouseup(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  189. begin
  190.   if (FType = pbDimension) and (Button = mbRight) then
  191.   begin
  192.     SelectButtonProperties;
  193.   end;
  194.   if (Ftype <> pbTarget) and (Button = mbLeft) and (FMouseState = xmPushed) then
  195.     Click;
  196.   SetState(xmNone);
  197. end;
  198.  
  199. procedure TPivotButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  200. begin
  201.   if (FType = pbTarget) then Exit;
  202.   if (Button = mbLeft) then
  203.   begin
  204.     SetState(xmPushed);
  205.     SaveX := X;
  206.     SaveY := Y;
  207.   end;
  208. end;
  209.  
  210. procedure TPivotButton.MouseMove(Shift: TShiftState; X, Y: Integer);
  211. begin
  212.   inherited;
  213.   if (FMouseState = xmPushed) and (FType = pbDimension) then
  214.   begin
  215.     if (abs(X-SaveX)>5) or (abs(SaveY-Y)>5) or (X=0) or (X=Width) or (Y=0) or (Y= Height) then
  216.     begin
  217.       SetState(xmDragging);
  218.       BeginDrag(True);
  219.     end;
  220.   end;
  221. end;
  222.  
  223. procedure TPivotButton.DragCanceled;
  224. begin
  225.   SetState(xmNone);
  226. end;
  227.  
  228. procedure TPivotButton.SetState;
  229. begin
  230.   FMouseState := value;
  231. end;
  232.  
  233. procedure TPivotButton.SelectButtonProperties;
  234. begin
  235.   if (FType = pbDimension) then
  236.   begin
  237.     if not (myDimInfo.iGroup in [dgRow, dgCol]) then
  238.       Exit;
  239.     if not assigned (FMenu) then
  240.       FMenu := TQuickMenu.Create(self);
  241.     FMenu.Clear;
  242.     if (mydiminfo.iGroup = dgRow) then
  243.       FMenu.AddLine(sMoveToCol, tmNone, 0)
  244.     else if (myDimInfo.iGroup = dgCol) then
  245.       FMenu.AddLine(sMoveToRow, tmNone, 0);
  246.     if (myDimInfo.iState <> dmPaged) then
  247.     begin
  248.       if (myDimInfo.IState <> dmDrilled) then
  249.         FMenu.AddLine(sDrilled, tmNone, 1)
  250.       else
  251.         FMenu.AddLine(sDrilled, tmChecked, 1);
  252.     end;
  253.     FMenu.OnSelected := EHOnProperty;
  254.     FMenu.PopUpAtMe(TWinControl(self),0,Height);
  255.   end;
  256. end;
  257.  
  258. procedure TPivotButton.SelectButtonValue;
  259. var
  260.   action,i,j,limit: Integer;
  261.   aVariant: variant;
  262.   DM: TCubeDim;
  263. begin
  264.   if not assigned(DecisionSource) then Exit;
  265.   if (FType = pbSummary) then
  266.   begin
  267.     if not assigned (FMenu) then
  268.       FMenu := TQuickMenu.Create(self);
  269.     FMenu.Clear;
  270.     for i := 0 to DecisionSource.nSums-1 do
  271.     begin
  272.       FMenu.AddLine(DecisionSource.GetSummaryName(i), tmNone, i);
  273.     end;
  274.     FMenu.OnSelected := EHOnValue;
  275.     FMenu.PopUpAtMe(TWinControl(self),0,Height);
  276.   end
  277.   else if (Ftype = pbInactive) then
  278.   begin
  279.     if not assigned (FMenu) then
  280.       FMenu := TQuickMenu.Create(self);
  281.     FMenu.Clear;
  282.     for i := 0 to DecisionSource.DecisionCube.DimensionMap.count-1 do
  283.     begin
  284.       DM := DecisionSource.DecisionCube.DimensionMap[i];
  285.       if (not DM.Loaded) and (DM.ActiveFlag <> diInActive) then
  286.       begin
  287.         FMenu.AddLine(DM.FieldName, tmNone, i);
  288.       end;
  289.     end;
  290.     FMenu.OnSelected := EHOnValue;
  291.     FMenu.PopUpAtMe(TWinControl(self),0,Height);
  292.   end
  293.   else if (FType = pbDimension) then
  294.   begin
  295.     if not assigned (FMenu) then
  296.       FMenu := TQuickMenu.Create(self);
  297.     FMenu.Clear;
  298.     limit := DecisionSource.GetDimensionMemberCount(myDim);
  299.     if (myDimInfo.IState = dmPaged) then
  300.     begin
  301.       action := 2;
  302.       for i := 0 to DecisionSource.GetDimensionMemberCount(myDim)-1 do
  303.       begin
  304.         DM := DecisionSource.DecisionCube.DimensionMap[myDim];
  305.         aVariant := DecisionSource.GetMemberAsVariant(myDim, i);
  306.         aVariant := DM.GetBinValues(aVariant);
  307.         if (VarType(aVariant) < varArray) then
  308.           FMenu.AddLine(FormatVariant(aVariant, ''), tmNone, Action)
  309.         else
  310.         begin
  311.           for j := VarArrayLowBound(aVariant,1) to VarArrayHighBound(aVariant,1) do
  312.           begin
  313.             FMenu.AddLine(FormatVariant(aVariant[j], ''), tmNone, Action);
  314.             action := action + 1;
  315.           end;
  316.         end;
  317.       end;
  318.     end
  319.     else
  320.     begin
  321.       FMenu.AddLine(sMakeDimOpen, tmNone, 0);
  322.       FMenu.AddLine(SAllValues, tmNone, 1);
  323.       FMenu.AddLine('-', tmNone, -1);
  324.       for i := 0 to limit-1 do
  325.       begin
  326.         FMenu.AddLine(DecisionSource.GetMemberAsString(myDim,i), tmNone, i+2);
  327.       end;
  328.     end;
  329.     FMenu.OnSelected := EHOnValue;
  330.     FMenu.PopUpAtMe(TWinControl(self),0,Height);
  331.   end;
  332. end;
  333.  
  334. procedure TPivotButton.EHOnValue(Sender: TObject);
  335. var
  336.   DM: TCubeDim;
  337.   myMap: TCubeDims;
  338.   i,j, si,ci: integer;
  339.   aVariant, bVariant: variant;
  340.   action: integer;
  341. begin
  342.   Action := FMenu.FAction;
  343.   FMenu.free;
  344.   FMenu := nil;
  345.   if (FType = pbSummary) then
  346.     DecisionSource.SetCurrentSummary(Action)
  347.   else if (FType = pbInactive) then
  348.   begin
  349.     myMap := TCubeDims.Create(DecisionSource.DecisionCube, TCubeDim);
  350.     try
  351.       myMap.Assign(DecisionSource.DecisionCube.DimensionMap);
  352.       for i := 0 to myMap.count-1 do
  353.       begin
  354.         myMap[i].loaded := False;
  355.       end;
  356.       if (myMap[action].isSummary) and (myMap[action].derivedFrom > 0) then
  357.       begin
  358.         if myMap.averageFieldCheck(action, si, ci) then
  359.         begin
  360.           myMap[si].loaded := True;
  361.           myMap[ci].loaded := True;
  362.         end;
  363.       end
  364.       else myMap[action].loaded := True;
  365.       try
  366.         DecisionSource.DecisionCube.Refresh(myMap, True);
  367.       except
  368.         on E: EDimensionMapError do
  369.         begin
  370.           raise exception.create(sCouldNotOpen + E.message);
  371.         end;
  372.       end;
  373.     finally
  374.       myMap.free;
  375.     end;
  376.   end
  377.   else if (FType = pbDimension) then
  378.   begin
  379.     if (Action = 0) then
  380.     begin
  381.       DecisionSource.ToggleDimIndex(myDimInfo.iGroup, myDimInfo.IIndex, False);
  382.     end
  383.     else if (Action = 1) then
  384.     begin
  385.       DecisionSource.DrillDimIndex(myDimInfo.iGroup, myDimInfo.iIndex, -1, False);
  386.     end
  387.     else if (myDimInfo.iState = dmPaged) then
  388.     begin
  389.       Action := Action - 2;
  390.       myMap := TCubeDims.Create(DecisionSource.DecisionCube, TCubeDim);
  391.       try
  392.         myMap.Assign(DecisionSource.DecisionCube.DimensionMap);
  393.         DM := myMap[myDim];
  394.         for i := 0 to DecisionSource.GetDimensionMemberCount(myDim)-1 do
  395.         begin
  396.           aVariant := DecisionSource.GetMemberAsVariant(myDim, i);
  397.           aVariant := DM.GetBinValues(aVariant);
  398.           if (VarType(aVariant) < varArray) then
  399.             Action := Action - 1
  400.           else
  401.           begin
  402.             for j := VarArrayLowBound(aVariant,1) to VarArrayHighBound(aVariant,1) do
  403.             begin
  404.               action := action - 1;
  405.               if (Action < 0) then
  406.               begin
  407.                 bVariant := aVariant[j];
  408.                 aVariant := bVariant;
  409.                 break;
  410.               end;
  411.             end;
  412.           end;
  413.           if (Action < 0) then
  414.             break;
  415.         end;
  416.         DM.StartValue := FormatVariant(aVariant,'');
  417.         try
  418.           DecisionSource.DecisionCube.Refresh(myMap, True );
  419.         except
  420.           on E: EDimensionMapError do
  421.           begin
  422.             raise exception.create(sCouldNotOpen + E.message);
  423.           end;
  424.         end;
  425.       finally
  426.         myMap.free;
  427.       end;
  428.       Exit;
  429.     end
  430.     else
  431.       DecisionSource.DrillDimIndex(myDimInfo.iGroup, myDimInfo.iIndex, Action-2, False);
  432.   end;
  433. end;
  434.  
  435. procedure TPivotButton.EHOnProperty(Sender: TObject);
  436. var
  437.   toGroup: TDimGroup;
  438. begin
  439.   try
  440.     if (FType = pbDimension) then
  441.     begin
  442.       if assigned(FMenu) then
  443.       begin
  444.         if (FMenu.FAction = 0) then
  445.         begin
  446.           if (myDimInfo.iGroup = dgRow) then
  447.             toGroup := dgCol
  448.           else
  449.             toGroup := dgRow;
  450.           FSource.MoveDimIndexes(myDimInfo.iGroup, toGroup, myDimInfo.IIndex, 0, False);
  451.         end
  452.         else if (FMenu.FAction = 1) then
  453.         begin
  454.           if (myDimInfo.Istate = dmDrilled) then
  455.             DecisionSource.ToggleDimIndex(mydiminfo.iGroup, myDimInfo.IIndex, False)
  456.           else
  457.             DecisionSource.DrillDimIndex(mydiminfo.iGroup, myDimInfo.iIndex, -1, False);
  458.         end;
  459.       end;
  460.     end;
  461.   finally
  462.     FMenu.Free;
  463.     FMenu := nil;
  464.   end;
  465. end;
  466.  
  467. procedure TPivotButton.Paint;
  468. var
  469.   mid, split, x,y: Integer;
  470.   FBmp: TBitMap;
  471.   aRect: TRect;
  472.   fString, string2: ShortString;
  473.   sHeight,sMargin: Integer;
  474.   i,ArrowX: Integer;
  475.   ArrowString: ShortString;
  476.   aChar: char;
  477.   Map: TCubeDims;
  478. begin
  479.   inherited;
  480.   if not assigned(FSource) then Exit;
  481.   ARect.Left := 0;
  482.   ARect.Right := Width;
  483.   ARect.Top := 0;
  484.   ARect.Bottom := Height;
  485.   if (FType = pbDimension) or (FType = pbInactive) or (FType = pbSummary) or (FType = pbTarget) then
  486.     with Canvas do
  487.     begin
  488.       if (Ftype = pbTarget) then
  489.       begin
  490.         FBmp := TBitmap.Create;
  491.         try
  492.           if (mydiminfo.iGroup = dgRow) then
  493.             FBmp.LoadFromResourceName(HInstance, 'Rows')
  494.           else
  495.             FBmp.LoadFromResourceName(HInstance, 'Cols');
  496.           x := (ARect.Right-FBMP.Width) div 2;
  497.           y := (ARect.Bottom - FBMP.Height) div 2;
  498.           BrushCopy(Rect(x, y, x+FBmp.width, y+FBmp.height), FBMP, Rect(0,0,FBmp.Width,FBmp.Height), clMaroon);
  499.         finally
  500.           FBmp.Free;
  501.         end;
  502.         Exit;
  503.       end;
  504.       sHeight := TextHeight('XXX');
  505.       if (FType = pbInactive) then
  506.       begin
  507.         string2 := '';
  508.         arrowString := '6';
  509.         fString := sActivateLabel;;
  510.       end
  511.       else if (Ftype = pbSummary) then
  512.       begin
  513.         string2 := '';
  514.         arrowString := '6';
  515.         i := FSource.CurrentSum;
  516.         fString := FSource.GetSummaryName(i);
  517.       end
  518.       else if (FType = pbDimension) then
  519.       begin
  520.         if (myDimInfo.IState = dmPaged) then
  521.         begin
  522.           Map := FSource.DecisionCube.DimensionMap;
  523.           String2 := FSource.GetDimensionName(myDim) + '=';
  524.           if Assigned(Map[myDim].BinData) then
  525.             fString := FormatVariant(Map[myDim].BinData.GetIBinValue(0,0), '')
  526.           else
  527.             fString := '';
  528.           arrowString := '';
  529.         end
  530.         else if (myDimInfo.IState = dmDrilled) then
  531.         begin
  532.           String2 := FSource.GetDimensionName(myDim) + '=';
  533.           if (myDimInfo.IValue >= 0) then
  534.             fString := FSource.GetMemberAsString(myDim, myDimInfo.IValue)
  535.           else
  536.             fString := SAllValues;
  537.           arrowString := '6';
  538.         end
  539.         else
  540.         begin
  541.           string2 := '';
  542.           arrowString := '';
  543.           if (myDim >= 0) then
  544.             fString := FSource.GetDimensionName(myDim);
  545.         end;
  546.       end;
  547.       if (TextWidth(FString+ArrowString) > (Width-4))
  548.       and (string2 = '') and (Height > ((sHeight*3) div 2)) then
  549.       begin
  550.         mid := length(fString) div 2;
  551.         split := 0;
  552.         for i := length(fString) downto 2 do
  553.         begin
  554.           aChar := fString[i];
  555.           if (aChar < 'A') or  ((aChar>'Z') and (aChar<'a')) or (aChar>'z') then
  556.           begin
  557.             if abs(mid-i) < abs(mid-split) then
  558.               split := i;
  559.           end;
  560.         end;
  561.         if (split = 0) then
  562.           for i := length(fString) downto 2 do
  563.           begin
  564.             if (fString[i] <= 'Z') and (fString[i-1] > 'Z') then
  565.             begin
  566.               if abs(mid-i) < abs(mid-split) then
  567.                 split := i;
  568.             end;
  569.           end;
  570.         if (split > 0) then
  571.         begin
  572.           string2 := Copy(fString,1, split-1);
  573.           if (fString[split] = ' ') then
  574.             split := split + 1;
  575.           fString := Copy(fString,split, length(fString));
  576.         end;
  577.       end;
  578.       while (TextWidth(fString+ArrowString) > (Width-4)) and (Length(fString) > 0) do
  579.         Delete(fString, Length(fString), 1);
  580.       while (TextWidth(string2) > (Width-4)) do
  581.         Delete(String2, Length(String2), 1);
  582.       x := ARect.Right-ARect.Left-TextWidth(FString+ArrowString);
  583.       if (x <= 0) then
  584.         x := ARect.Left
  585.       else
  586.         x := ARect.Left + (x div 2);
  587.       ArrowX := x + TextWidth(fString);
  588.       sMargin := (Height-2*(sHeight)) div 2;
  589.       if (sMargin >= 0) and (string2 <> '') then
  590.       begin
  591.         y := ARect.Bottom - sHeight - (sMargin);
  592.           TextOut(x, y, fString);
  593.         x := Width-TextWidth(String2);
  594.         if (x <= 0) then
  595.           x := ARect.Left
  596.         else
  597.           x := ARect.Left + (x div 2);
  598.         TextOut(x, ARect.Top+(sMargin), String2);
  599.       end
  600.       else
  601.       begin
  602.         y := (ARect.Top + ARect.Bottom - TextHeight(fString)) div 2;
  603.         if (y < 0) then y := 0;
  604.           TextOut(x, y, fString);
  605.       end;
  606.       if (ArrowString <> '') then
  607.       begin
  608.         Font.Name := 'Marlett';
  609.         Font.Charset := Default_CharSet;
  610.         Font.Pitch := fpDefault;
  611.         Font.Style := [];
  612.         TextOut(ArrowX, y, ArrowString);
  613.       end;
  614.     end;
  615. end;
  616. procedure TPivotButton.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
  617. var
  618.   sdimGroup, ddimGroup: TDimGroup;
  619.   sIndex, dIndex: Integer;
  620. begin
  621.   inherited;
  622.   Accept := False;
  623.   if (FType = pbSummary) then Exit;
  624.   if not (Source is TPivotButton) then Exit;
  625.   if TPivotButton(Source).FSource <> FSource then Exit;
  626.   ddimGroup := mydiminfo.iGroup;
  627.   sdimGroup := TPivotButton(Source).MyDimInfo.IGroup;
  628.   sIndex := TPivotButton(Source).MyDimInfo.IIndex;
  629.   dIndex := MyDimInfo.IIndex;
  630.   if (FType = pbTarget) or (X > (Width - (Width div 8))) then   { add to the right }
  631.   begin
  632.     if (ddimGroup = sdimGroup) and ((dIndex = (sIndex-1)) or (dIndex = sIndex)) then
  633.       Exit;
  634.     TPivotButton(Source).DragCursor := crDimIns;
  635.   end
  636.   else if (X < Width div 8) then
  637.   begin
  638.     if (ddimGroup = sdimGroup) and (dIndex = (sIndex + 1)) then Exit;
  639.     TPivotButton(Source).DragCursor := crDimIns;
  640.   end
  641.   else        
  642.   begin
  643.     if (ddimGroup = sdimGroup) and (dIndex = sIndex) then
  644.       TPivotButton(Source).DragCursor := crDimMove;
  645.     TPivotButton(Source).DragCursor := crDimMove;
  646.   end;
  647.   Accept := True;
  648. end;
  649.  
  650. procedure TPivotButton.DragDrop(Source: TObject; X, Y: Integer);
  651. var
  652.   sdimGroup, ddimGroup: TDimGroup;
  653.   sIndex, dIndex: Integer;
  654. begin
  655.   inherited;
  656.   ddimGroup := mydiminfo.iGroup;
  657.   sdimGroup := TPivotButton(Source).MyDimInfo.IGroup;
  658.   sIndex := TPivotButton(Source).MyDimInfo.IIndex;
  659.   dIndex := MyDimInfo.IIndex;
  660.   if (ddimGroup = sdimGroup) and (sIndex = dIndex) then
  661.     Exit;  { do not drop on self }
  662.   if (FType = pbTarget) or (X > (Width - (Width div 8))) then
  663.     FSource.MoveDimIndexes(sdimGroup, ddimGroup, sIndex, dIndex+1, False)
  664.   else if (X < (Width div 8)) then
  665.     FSource.MoveDimIndexes(sdimGroup, ddimGroup, sIndex, dIndex, False)
  666.   else
  667.     FSource.SwapDimIndexes(sdimGroup, ddimGroup, sIndex, dIndex, False);
  668. end;
  669.  
  670. procedure TQuickMenu.Clear;
  671. begin
  672.   while (Items.count > 0) do
  673.     Items.Delete(0);
  674. end;
  675.  
  676. procedure TQuickMenu.PopUpAtMe(aControl: TWinControl; x,y: Integer);
  677. var
  678.   aPoint: TPoint;
  679. begin
  680.   aPoint.x := x;
  681.   aPoint.y := y;
  682.   aPoint := aControl.ClientToScreen(aPoint);
  683.   PopUp(aPoint.x, aPoint.y);
  684. end;
  685.  
  686. procedure TQuickMenu.AddLine(const value: string; Prop: TMenuProp; Action: Integer);
  687. var
  688.   aMenuItem: TQuickMenuitem;
  689. begin
  690.   aMenuItem := TQuickMenuItem.Create(self);
  691.   aMenuItem.Action := Action;
  692.   aMenuItem.Caption := value;
  693.   aMenuItem.Enabled := True;
  694.   aMenuItem.OnClick := EHOnItemClick;
  695.   if (Prop = tmChecked) then aMenuItem.Checked := True;
  696.   if (Prop = tmRadio) then
  697.   begin
  698.     aMenuItem.Checked := True;
  699.     aMenuItem.RadioItem := True;
  700.   end;
  701.   Items.Add(aMenuItem);
  702. end;
  703.  
  704. procedure TQuickMenu.SetTitle(value: string);
  705. begin
  706.   Clear;
  707.   AddLine(value, tmNone, -1);
  708.   AddLine('-', tmNone, -1);
  709. end;
  710.  
  711. procedure TQuickMenu.EHOnItemClick(Sender: TObject);
  712. var
  713.   i: Integer;
  714. begin
  715.   for i := 0 to Items.count-1 do
  716.   begin
  717.     if (Sender = Items[i]) then
  718.     begin
  719.       FAction := TQuickMenuItem(Items[i]).Action;
  720.       if (FAction >= 0) and assigned (FOnSelected) then
  721.         FOnSelected(self);
  722.       Exit;
  723.     end;
  724.   end;
  725. end;
  726.  
  727. end.
  728.